perm filename TAPR2L.SAI[REV,MUS] blob
sn#503398 filedate 1977-07-19 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00016 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 BEGIN "TAPR2L"
C00004 00003 ∂ Declarations for JAM's display routines and my PP routines.
C00005 00004 INTERNAL PROCEDURE IMPLS2(
C00008 00005 PROCEDURE fill_buffer(
C00011 00006 PROCEDURE next_sample(
C00012 00007 PNT(REV_STATE) PROCEDURE init_state(
C00014 00008 PROCEDURE init_sample(
C00015 00009 SIMPLE PROCEDURE draw(
C00016 00010 PROCEDURE init_draw(
C00018 00011 INTEGER s,d,q,
C00020 00012 END "impuls"
C00021 00013 PROCEDURE esc_break(
C00022 00014 REAL PROCEDURE LOG10(REAL X)
C00023 00015 ∂ Real program.
C00027 00016 END "TAPR2L".
C00028 ENDMK
C⊗;
BEGIN "TAPR2L"
REQUIRE "HEADER.SAI[LIB,KS]" SOURCE_FILE;
∂ Test implementation of 2nd order all-pass reverberator in lattice form.
;
RECLASS ALLTWO(
INTEGER NUMBER_OF_SAMPLES, CLOCK_RATE;
REAL GAIN_ONE, GAIN_TWO, DELAY_TIME, DECAY_TIME);
∂ Declarations for JAM's display routines and my PP routines.;
REQUIRE "JAMLIB[SUB,SYS]" LIBRARY;
EXTERNAL PROCEDURE WRITE(
INTEGER id, pog);
EXTERNAL BOOLEAN PROCEDURE DRELS(
REFERENCE INTEGER id);
EXTERNAL PROCEDURE TYPLOC(
INTEGER ymin,ymax);
EXTERNAL PROCEDURE PPSIZE(
INTEGER #glitches, #lines(1));
EXTERNAL PROCEDURE PPSELECT(
INTEGER pp;
BOOLEAN keep_map(FALSE));
INTERNAL PROCEDURE IMPLS2(
REFERENCE INTEGER id;
RECORD_POINTER(ALLTWO) rev_instance;
REAL duration);
∂ Using standard JAM display package, allocate a buffer for display if
one does not exist and fill it with a graph of the impulse response of
the 2nd order unit reverberator over the given duration.
;
BEGIN "impuls"
EXTERNAL PROCEDURE DSETUP(INTEGER nwds; REFERENCE INTEGER id);
DEFINE DGET(id,nwds)=⊂DSETUP(nwds,id)⊃;
EXTERNAL BOOLEAN PROCEDURE DRELS(REFERENCE INTEGER id);
EXTERNAL PROCEDURE WRITE(INTEGER id,pog);
EXTERNAL PROCEDURE BUFCLR(INTEGER id,nwds);
EXTERNAL PROCEDURE AVECT(INTEGER id,X,Y);
EXTERNAL PROCEDURE AIVECT(INTEGER id,X,Y);
EXTERNAL PROCEDURE RVECT(INTEGER id,dX,dY);
EXTERNAL PROCEDURE RIVECT(INTEGER id,dX,dY);
EXTERNAL PROCEDURE AXIS(INTEGER id;
REAL vmin,vmax;
REFERENCE REAL scale,offset;
INTEGER pos,min,max;
BOOLEAN xaxis);
EXTERNAL PROCEDURE DTEXT(INTEGER id;
STRING text;
REAL scale(0), angle(0));
DEFINE DISPLAY_WIDTH=769, DW=DISPLAY_WIDTH; ∂ Should have prime DW;
DEFINE DISPLAY_HEIGHT=300, DH=DISPLAY_HEIGHT;
DEFINE LO_X=128-512, LO_Y=150,
HI_X=LO_X+DW, HI_Y=LO_Y+DH;
DEFINE PER_LINE=24;
DEFINE TEXT_COL=HI_X-250, TEXT_ROW=HI_Y-PER_LINE;
DEFINE BUFSIZ=4096;
RECLASS REV_STATE(
REAL ARRAY MEM1, MEM2; INTEGER delay;
REAL gain1, gain2; INTEGER pos);
∂ PROCEDURE TO CALL A RECORD'S HANDLER PROCEDURE;
EXTERNAL RECORD_POINTER(ANY_CLASS) PROCEDURE $RECFN(
INTEGER OP;
RECORD_POINTER(ANY_CLASS) R);
∂ OP VALUES FOR $RECFN;
DEFINE ALLOCATE_RECORD = 1;
DEFINE MARK_SUBFIELDS = 4;
DEFINE DELETE_RECORD = 5;
PROCEDURE fill_buffer(
PNT(REV_STATE) state;
REF REAL in_buffer;
REF REAL out_buffer;
INT size);
BEGIN "fill buffer"
EXTERNAL PROCEDURE APR2(REFERENCE REAL IN, OUT; INTEGER n;
REFERENCE REAL MEM1, MEM2; INTEGER delay;
REAL gain1, gain2; REFERENCE INTEGER pos);
IF state = λ
THEN BEGIN
ARRBLT(out_buffer,in_buffer,size);
RETURN;
END;
APR2(in_buffer,out_buffer,size,
REV_STATE:MEM1[state][1],
REV_STATE:MEM2[state][1],
REV_STATE:delay[state],
REV_STATE:gain1[state],
REV_STATE:gain2[state],
REV_STATE:pos[state]
);
END "fill buffer";
PROCEDURE next_sample(
REFERENCE REAL biggest_sample;
RECORD_POINTER(REV_STATE) state;
REFERENCE INTEGER sample_index);
BEGIN "next sample"
PRELOAD_WITH [BUFSIZ] 0.0;
OWN REAL ARRAY ZEROS[1:BUFSIZ];
OWN REAL ARRAY buf[1:BUFSIZ];
IF
sample_index > BUFSIZ
THEN BEGIN
fill_buffer(state,ZEROS[1],buf[1],BUFSIZ);
sample_index ← 1;
END;
biggest_sample ← biggest_sample MAX ABS buf[sample_index];
sample_index ← sample_index+1;
END "next sample";
PNT(REV_STATE) PROCEDURE init_state(
PNT(ALLTWO) rev);
BEGIN "init state"
PNT(REV_STATE) state;
INT size;
state ← NEW_RECORD(REV_STATE);
size ← ALLTWO:NUMBER_OF_SAMPLES[rev];
NewArray(REAL,REV_STATE:MEM1[state],[1:size]);
NewArray(REAL,REV_STATE:MEM2[state],[1:size]);
ARRCLR(REV_STATE:MEM1[state]);
ARRCLR(REV_STATE:MEM2[state]);
REV_STATE:delay[state] ← size;
REV_STATE:gain1[state] ← ALLTWO:GAIN_ONE[rev];
REV_STATE:gain2[state] ← ALLTWO:GAIN_TWO[rev];
REV_STATE:pos[state] ← 0;
RETURN(state);
END "init state";
PROCEDURE init_sample(
RECORD_POINTER(ALLTWO) rev;
REFERENCE REAL scale;
REFERENCE RECORD_POINTER(REV_STATE) state;
REFERENCE INTEGER index);
BEGIN "init sample"
REAL ONE; ONE ← 1.0; ∂ For use as REFERENCE argument;
state ← init_state(rev);
fill_buffer(state,ONE,scale,1);
scale ← ABS scale;
index ← BUFSIZ+1;
END "init sample";
SIMPLE PROCEDURE draw(
INTEGER id;
REFERENCE REAL sample;
REFERENCE INTEGER x_displacement;
REAL y_scale);
BEGIN "draw"
INTEGER screen_y;
x_displacement ← x_displacement+1;
IF
sample = 0
THEN
RETURN;
screen_y ← sample*y_scale;
RIVECT(id,x_displacement,screen_y);
RVECT(id,0,-screen_y);
x_displacement ← 0;
sample ← 0;
END "draw";
PROCEDURE init_draw(
INTEGER id;
RECORD_POINTER(ALLTWO) rev;
REAL x_lo, y_lo, x_hi, y_hi,
decay, scale;
REFERENCE INTEGER x_displacement;
REFERENCE REAL y_scale);
BEGIN "init draw"
REAL y_offset, x_offset, x_scale;
∂ RECORD_POINTER(REV_STATE_LIST) rev_chain;
INTEGER pos, wid, dig;
AXIS(id,0.0,scale,y_scale,y_offset,x_lo,y_lo,y_hi,FALSE);
AXIS(id,0.0,decay,x_scale,x_offset,y_lo,x_lo,x_hi,TRUE);
IFC FALSE
THENC
IF
rev ≠ NULL_RECORD
THEN BEGIN "list units"
rev_chain ← CASCADE:FIRST_UNIT[rev];
pos ← TEXT_ROW;
AIVECT(id,TEXT_COL,pos);
GETFORMAT(wid,dig);
SETFORMAT(0,0);
DTEXT(id,CVS(CASCADE:CLOCK_RATE[rev])&"/sec");
WHILE
rev_chain ≠ NULL_RECORD
DO BEGIN
AIVECT(id,TEXT_COL,pos ← pos-PER_LINE);
SETFORMAT(4,3);
DTEXT(id,CVS(REV_STATE_LIST:MEM_SIZE[rev_chain])&","&
CVF(REV_STATE_LIST:GAIN[rev_chain]));
rev_chain ← REV_STATE_LIST:NEXT_UNIT[rev_chain];
END;
SETFORMAT(wid,dig);
END "list units";
ENDC
x_displacement ← 0;
AIVECT(id,x_lo,y_lo);
END "init draw";
INTEGER s,d,q,
index,
x_displacement;
REAL big,
scale,
y_scale;
RECORD_POINTER(REV_STATE) state;
IF
id = 0
THEN
DGET(id,2500)
ELSE
BUFCLR(id,2500);
init_sample(rev_instance,
scale,
state,index);
init_draw(id,
rev_instance,
lo_x,lo_y,hi_x,hi_y,
duration,scale,
x_displacement,y_scale);
IF
rev_instance = NULL_RECORD
THEN
RETURN;
big ← 0.0;
d ← DISPLAY_WIDTH;
s ← duration*ALLTWO:CLOCK_RATE[rev_instance];
IF
(s MOD d) = 0
THEN
s ← s+1;
q ← s-d;
WHILE
q ≠ 0
DO BEGIN
WHILE
q > 0
DO BEGIN
next_sample(big,state,index);
q ← q-d;
END;
WHILE
q < 0
DO BEGIN
draw(id,big,x_displacement,y_scale);
q ← q+s;
END;
END;
next_sample(big,state,index);
draw(id,big,x_displacement,y_scale);
$RECFN(DELETE_RECORD,state);
END "impuls";
PROCEDURE esc_break(
INTEGER char;
BOOLEAN break(FALSE));
∂ Executes the terminal ESC or BREAK function specified. If break is TRUE, then
will do [BREAK]char, else [ESC]char.
;
START_CODE
MOVSI 2,'4000; ∂ ESC/BREAK function;
HRR 2,char;
SKIPE break;
TRO 2,'400; ∂ Set this bit for BREAK function;
HRROI 1,2; ∂ Indicates list of commands 1 long - just [ESC]/[BREAK] char;
CALLI 1,'400121; ∂ TTYSET UUO;
END;
REAL PROCEDURE LOG10(REAL X);
RETURN(0.4342944819*LOG(X)); ∂ Log10(e)*Ln(x).;
∂ Real program.;
∂ RECLASS ALLTWO(
∂ INTEGER NUMBER_OF_SAMPLES, CLOCK_RATE;
∂ REAL GAIN_ONE, GAIN_TWO, DELAY_TIME, DECAY_TIME);
∂ PROCEDURE IMPLS2(
∂ REFERENCE INTEGER id;
∂ RECORD_POINTER(ALLTWO) rev_instance;
∂ REAL duration);
INTEGER i,j,k; ∂ For miscellany ;
STRING s,t,u; ∂ For more of the same ;
EXTERNAL INTEGER _SKIP_;∂ For looking at activation character from INCHWL ;
REAL x,y,z; ∂ More miscellany ;
INTEGER id; ∂ For JAM display stuff ;
PNT(ALLTWO) rev,oldrev; ∂ Some things to play with ;
DEFINE MAIN_POS=96;
DEFINE PER_LINE=24;
DEFINE MAIN_LINES=20;
DEFINE IMPULSE_PIECE=1;
PPSELECT(1); ∂ So interactions previous to Fiddling not clobbered.;
TYPLOC(MAIN_POS-(PER_LINE*MAIN_LINES),MAIN_POS);
PPSIZE(MAIN_LINES); ∂ This call is not superfluous! Sets lines/glitch = 1;
rev ← NEW_RECORD(ALLTWO);
WHILE TRUE
DO BEGIN "Fiddling around with parameters"
PRINT("Fiddling ... ",↓);
PRINT("Old values:",TAB,"Gain One",TAB,"Gain Two",TAB,"Delay",TAB,"Clock",↓);
PRINT("New values:",TAB);
s ← NULL;
SETFORMAT(8,4);
s ← s&CVF(ALLTWO:GAIN_ONE[rev]);
s ← s&TAB&CVF(ALLTWO:GAIN_TWO[rev]);
SETFORMAT(5,2);
s ← s&TAB&CVF(ALLTWO:DELAY_TIME[rev]*1000.0); ∂ In milliseconds ;
s ← s&TAB&CVS(ALLTWO:CLOCK_RATE[rev]);
s ← s&↓;
LODED(s);
t ← INCHWL;
IF _SKIP_ = ALT
THEN DONE "Fiddling around with parameters";
y ← REALSCAN(t,k);
IF y = 0
THEN y ← 1.0/(2.0↑0.5);
ALLTWO:GAIN_ONE[rev] ← y;
x ← REALSCAN(t,k);
IF x = 0
THEN x ← 0.75;
ALLTWO:GAIN_TWO[rev] ← x;
x ← REALSCAN(t,k);
IF x = 0
THEN x ← 50.0;
x ← x/1000.0;
ALLTWO:DELAY_TIME[rev] ← x;
j ← INTSCAN(t,k);
IF j = 0
THEN j ← 12800;
IF j < 1000
THEN j ← j*100;
ALLTWO:CLOCK_RATE[rev] ← j;
ALLTWO:NUMBER_OF_SAMPLES[rev] ← x*j; ∂ Delay*Clock = No. of samples ;
z ← -3.0*x/LOG10(ABS y); ∂ x = delay, y = gain one ;
ALLTWO:DECAY_TIME[rev] ← z;
IMPLS2(id,rev,z); ∂ Draw into buffer ;
WRITE(id,IMPULSE_PIECE);
esc_break("P");
END "Fiddling around with parameters";
DRELS(id);
CLRBUF;
PPSELECT(0);
esc_break("N",TRUE); ∂ Clear and normalize page;
END "TAPR2L".